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-- StringCompactor.mesa; edited by Sandman; April 16, 1978 11:06 AM 

DIRECTORY 

AltoDefs: FROM "altodefs", 
lODefs: FROM "iodefs", 
SegmentDefs: FROM "segmentdef s" , 
StreamDefs: FROM "streamdef s" , 
StringDefs: FROM "stringdef s" , 
SystemDefs: FROM "systemdef s" ; 

DEFINITIONS FROM StreamDefs, SegmentDefs; 

StringCompactor: PROGRAM IMPORTS lODefs, SegmentDefs, StreamDefs. StringDefs, SystemDefs 

BEGIN 

CompStrDesc: TYPE » RECORD [ 
offset, length: CARDINAL]; 

nStrings: CARDINAL; 
nChars: CARDINAL; 
nArrays: CARDINAL; 

InStream, sOutStream, rOutStream: StreamHandle; 

SLptr: TYPE = POINTER TO SL; 

SL: TYPE = RECORD [ 
link: SLptr, 

startindex: Streamlndex, 
length: CARDINAL]; 

ALptr: TYPE = POINTER TO AL; 

AL: TYPE = RECORD [ 
link: ALptr. 
name: NL, 

ARRAYindex: Streamlndex. 
NeedsIndexDef : BOOLEAN, 
headSL, tailSL: SLptr, 
nstrings: CARDINAL]; 

NL: TYPE = RECORD [ 

startindex: Streamlndex, 
length: CARDINAL]; 

Backup: PROCEDURE [s: StreamHandle] « 
BEGIN OPEN StreamDefs; 

Setlndex[s, ModifyIndex[GetIndex[s] , -1]]; 
RETURN 
END; 

NextString: PROCEDURE [s: SLptr] RETURNS [BOOLEAN] » 
BEGIN 

c: CHARACTER; 
nc: CARDINAL <- 0; 
QuoteFound, Col lectingChars : BOOLEAN ^ FALSE; 

DO 

IF InStream. endof[InStream] THEN SIGNAL SyntaxError; 

c <- InStream. get[InStream] ; 

IF c = '; AND -Col lectingChars THEN RETURN[FALSE] ; 

IF c = "• THEN 

IF QuoteFound THEN 

IF CollectingChars THEN 

BEGIN QuoteFound <- FALSE; nc <- nc+1 END 
ELSE ERROR 
ELSE 

IF CollectingChars THEN QuoteFound ^ TRUE 
ELSE 

BEGIN s. startindex <- GetIndex[InStream] ; CollectingChars ^ TRUE; END 
ELSE 

IF QuoteFound THEN 

BEGIN s. length ^ nc; BackUp[InS tream] ; EXIT END 
ELSE IF CollectingChars THEN nc ^ nc^-l; 
ENDLOOP; 
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nChars ^ nChars + nc; 
nStrings «- nStrings+1; 
RETURN[TRUE] 
END; 

lastCR: Streamlndex; 

ParseState: TYPE « {start, aRray, arRay, arrAy, arraY, siring, stRing, 
string, striNg, strinG, Of, oF, end}; 

Nextltem: PROCEDURE [a: ALptr] « 
BEGIN 

c: CHARACTER; 
nc: CARDINAL ^ 0; 
state: ParseState ^ start; 
array: BOOLEAN; 

DO 

IF InStream.endof[InStream] THEN SIGNAL AllDone; 
c ^ InStream.get[InStream] ; 
nc ^ nc+1; 
SELECT c FROM 
'A => 
state ♦- SELECT state FROM 
start ="> aRray, 
arrAy «> arraY, 
StRing => string, 
ENDCASE => start; 
•R => 
state ^ SELECT state FROM 
aRray => arRay, 
arRay => arrAy, 
StRing => string, 
ENDCASE => start; 
•Y => 
BEGIN 
IF state = arraY THEN 

BEGIN array ^ TRUE; a.ARRAYindex <- GetIndex[InStream] ; state ^ end END 
ELSE state <- start; 
END; 
'S => 
IF state = start THEN 

BEGIN a. name, length ♦■ nc-1; state ^ sTring END 
ELSE state <- start; 
'T => 

state *■ IF state - sTring THEN stRing ELSE start; 
'I => 

state *- IF state = string THEN striNg ELSE start; 
'N => 

state *- IF state = striNg THEN strinG ELSE start; 
'G => 

IF state = StrinG THEN 

BEGIN array <- FALSE; state *- end END 
ELSE state *- start; 
lODefs.CR => 
BEGIN 

IF state « end THEN EXIT; 
lastCR *- Getlndex[ InStream] ; 
nc <- 0; state <- start; 
END; 
IN [OC' ] => IF state « end THEN EXIT ELSE state <- start; 
ENDCASE -> state <- start; 
ENDLOOP; 

a . name . startindex <- lastCR; 
a.NeedsIndexDef <- array; 
IF array THEN 
BEGIN 

state <- Of; 
DO 

IF InStream. endof[InStream] THEN SIGNAL SyntaxError; 
c ^ InStream. get[InStream]; 
nc ♦- nc+1; 
SELECT c FROM 
IN [OC. . ' ] »> 

SELECT state FROM 
start «> state <- Of; 
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Of «> NULL; 
end «> EXIT; 

ENDCASE «> state <- start; 
•0 -> 

state ^ IF state « Of THEN oF ELSE start; 
•F -> 

state <- IF state = oF THEN end ELSE start; 
ENDCASE => BEGIN a . NeedsIndexDef ^ FALSE; state <- start; END; 
ENDLOOP; 
a. name, length <- nc; 
END; 
Col lectStrings[a] ; 

IF array THEN nArrays ♦- nArrays + 1; 
RETURN 
END; 

AllDone: SIGNAL « CODE; 
SyntaxError: SIGNAL « CODE; 

headAL, tailAL: ALptr; 

CollectStrings: PROCEDURE [a: ALptr] ■ 
BEGIN 
s: SLptr; 
oldnStrings: CARDINAL ^ nStrings; 

a.headSL ♦- a.tailSL <- NIL; 

WHILE NextString[s ^ AnocateSL[]] DO 

AppendSL[a, s]; 

ENDLOOP; 
SystemDef s . FreeHeapNode[s] ; 
a.nstrings <- nStrings - oldnStrings; 
RETURN 
END; 



CollectArrays: PROCEDURE - 
BEGIN 
a: ALptr; 

headAL ^ tailAL <- NIL; 

nStrings <- 0; nChars <- 0; nArrays ^ 0; 

lastCR <- StreaniIndex[0,0]; 

DO 

Nextltem[a <- AnocateAL[] ! 

AllDone => BEGIN SystemDef s . FreeHeapNode[a] ; EXIT END]; 

AppendAL[a]; 

ENDLOOP; 
RETURN 
END; 



AHocateSL: PROCEDURE RETURNS [s: SLptr] = 
BEGIN 

s *- SystemDefs.AnocateHeapNode[SUE[SL]]; 
s.link *- NIL; 
RETURN 
END; 

AppendSL: PROCEDURE [a: ALptr, s: SLptr] « 
BEGIN 

IF a.tailSL = NIL THEN a.headSL <- s 
ELSE a.tailSL. link ^ s; 
a. tailSL ♦- s ; 
RETURN 
END; 



AllocateAL: PROCEDURE RETURNS [a: ALptr] - 
BEGIN 

a <- SystemDefs.AnocateHeapNode[SIZE[AL]]; 
a. link ^ NIL; 
RETURN 
END; 



AppendAL: PROCEDURE [a: ALptr] 
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BEGIN 

IF tailAL « NIL THEN headAL ^ a 

ELSE tailAL.Iink ♦- a; 

tailAL ♦- a; 

RETURN 

END: 



OutCompactStrings: PROCEDURE » 
BEGIN 

tSH: StreamHandle; 
a: ALptr <- headAL; 
s: SLptr; 

charpos: CARDINAL ^ 0; 
i: CARDINAL; 
prevs: SLptr; 
c: CHARACTER; 

sOutStream.reset[sOutStreani]; 

sOutStream.put[sOutStream, nStrings*SIZE[CompStrDesc]+l] ; 
WHILE a ff NIL DO 
s <- a.headSL; 
WHILE s ff NIL DO 

sOu tS t ream. put[sOutSt ream, charpos]; 
sOu tS t ream. put[sOutSt ream, s . length] ; 
charpos <- charpos+s . length; 
s ^ s . 1 ink; 
ENDLOOP; 
a *- a. 1 ink; 
ENDLOOP; 
sOu tS t ream. put[sOutSt ream, nChars]; 
sOutStream.put[sOutStream, nChars]; 
C1eanupDiskStream[sOutStream]; 
tSH ♦- CreateByteStream[outFH, Write+Append]; 
SetIndex[tSH, GetIndex[sOutStream]] ; 
sOu tSt ream. reset[sOutSt ream]; 
sOutStream.destroy[sOutStream]; 
sOutStream <- tSH; 
a <- headAL; 
WHILE a ff NIL DO 
s <- a.headSL; 
WHILE s ff NIL DO 

SetIndex[InStream, s. startindex]; 
FOR i IN [0. .s. length) DO 
c *- InStream.get[InStream] ; 
IF c = '" THEN c ^ InStream.get[InStream] ; 
sOutStream. put[sOutStream, c] 
ENDLOOP; 
prevs ^ s; 
s ♦- s . 1 ink; 

SystemDef s .FreeHeapNode[prevs]; 
ENDLOOP; 
a ♦- a. 1 ink; 
ENDLOOP; 
sOutStream. destroy [sOutStream]; 
RETURN 
END; 

OutRealStrings: PROCEDURE » 
BEGIN 

a: ALptr <- headAL; 
s: SLptr; 

wordpos: CARDINAL <- nStrings+1; 
i: CARDINAL; 
prevs: SLptr; 
c: CHARACTER; 

buffer: RECORD[even,odd: CHARACTER]; 
parity: {even, odd} <- even; 
FlushBuffer: PROCEDURE « 

BEGIN 

IF parity « odd THEN PutChar[IODef s .NUL]; 

END; 
PutChar: PROCEDURE [c: CHARACTER] « 

BEGIN 

IF parity « even THEN BEGIN buffer. even <- c; parity <~ odd END 

ELSE 
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BEGIN 

buffer. odd <- c; 

sOu tS t ream. put[sOutSt ream, buffer]; 
parity ♦- even 
END; 
END; 

sOutStream.reset[sOutStream]; 
sOu tS t ream. put[sOutSt ream, nStrings] ; 
WHILE a # NIL DO 
s <" a.headSL; 
WHILE s ff NIL DO 

sOu tS t ream. put[sOutSt ream, wordpos] ; 
wordpos ^ wordpos+StringDefs.WordsForString[s. length] ; 
s ^ S.I ink; 
ENDLOOP; 
a ♦- a. 1 ink; 
ENDLOOP; 
a ^ headAL; 
WHILE a # NIL DO 
s ^ a.headSL; 
WHILE s ^ NIL DO 

SetIndex[InStream, s.startindex]; 
FlushBuffer[]; 

sOu tS tre am. put[sOutStre am, s. length]; 
sOu tS t ream. put [sOutSt ream, s . length] ; 
FOR i IN [0. .s. length) DO 
c <- InStream.get[InStream]; 
IF c = •" THEN c ^ InStream.get[InStream]; 
PutChar[c] 
ENDLOOP; 
prevs <- s; 
s ♦- s. 1 ink; 

SystemDef s . FreeHeapNode[prevs] ; 
ENDLOOP; 
a ♦- a. link; 
ENDLOOP; 
FlushBuffer[]; 

sOutStream.destroy[sOutStream] ; 
RETURN 
END; 

OutStrings: PROCEDURE [compact: BOOLEAN] - 
BEGIN 

IF compact THEN OutCompactStrings[] ELSE OutRealStrings[]; 
RETURN 
END; 

OutRecordDecl : PROCEDURE [compact: BOOLEAN] « 
BEGIN 

a: ALptr <- headAL; 
preva: ALptr; 
i: CARDINAL; 

rOutStream. reset[rOutStream]; 
FOR i IN [0, .routfile. length) DO 

IF routfile[i] = ' . THEN EXIT; 

rOutStream.put[rOutStream, routfile[i]]; 

ENDLOOP; 
OutString[": DEFINITIONS » 

BEGIN 

IF compact THEN OutString[" CSRptr: TYPE « POINTER TO CompStrRecord ; 

CompStrDesc: TYPE « RECORD [offset, length: CARDINAL]; 

CompStrRecord: TYPE = RECORD [ 
relativebase: CARDINAL, 

"3 

ELSE OutString[" Str ingRecord : TYPE - RECORD [ 
nStrings: CARDINAL, 

"]: 
DO 

SetIndex[InStream, a. name, startindex]; 
OutStr ing[" "]; 
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FOR i IN [0. .a. name. length) DO 
IF a.NeedsIndexDef THEN 

IF GetIndex[InStream] « a.ARRAYindex THEN 
BEGIN OPEN lODefs; 
OutString['' [0.."]; 

OutNumbor[rOutStream, a.nstrings, Number Format[ 10 , FALSE , FALSE ,0]] ; 
rOutStream.put[rOutStream, •)]; 
END; 
rOu tS t ream. put[rOutSt ream, InStream. get[InStream]]; 
ENOLOOP; 
OutString[IF compact THEN "CompStrDesc" ELSE "STRING"]; 
preva *- a; 
a <- a. 1 ink; 

SystemDef s . FreeHeapNode[ preva]; 
IF a « NIL THEN EXIT; 
rOutStream. put[rOutStream, ',]; 
rOu tSt ream. put [rOutStream, lODefs.CR]; 
ENDLOOP; 
OutString["]; 

END. .."]; 
rOutStream. destroy [rOutStream]; 
RETURN 
END; 

OutString: PROCEDURE [s: STRING] « 
BEGIN 
i: CARDINAL; 

FOR i IN [0. .8. length) DO rOutStream. put[rOutStream, s[i]]; ENDLOOP; 

RETURN 

END; 

YesNo: PROCEDURE [question: STRING] RETURNS [BOOLEAN] = 
BEGIN 

OPEN lODefs; 
c: CHARACTER; 
Wr i test ring[ quest ion]; 
c ^ ReadChar[]; 
DO 

SELECT c FROM 

•Y.'y => BEGIN Wri teLine["Yes"] ; RETURN[TRUE] END; 
'N.'n => BEGIN Wri teLine["No"] ; RETURN[FALSE] END; 
ENDCASE => WriteString["? 
Type Y or N "]; 
ENDLOOP; 
END; 

infile: STRING ^ [40]; 
soutfile: STRING *- [40]; 
routfile: STRING <- [40]; 
outFH: FileHandle; 
compact: BOOLEAN; 

BEGIN OPEN lODefs; 

WriteLine["Mesa String Compactor"]; 

DO 

WriteChar[CR]; 

WriteChar[CR]; 

Wr i teString["Input file: "]; 

ReadID[infile]; 

IF infile. length = THEN EXIT; 

Wri teString[" , string output file: "]; 

ReadID[soutf ile]; 

Wr iteString[" 

record output file: "]; 
ReadID[routfile]; 
WriteChar[CR]; 

compact ♦- YesNo["Do you want the compact representation? "]; 
InStream ^ CreateHyteStream[NewFile[ infile , Read, OldFi leOnly] , Read]; 

sOutStream <- CrealeWordStream[outFH <~ NewFilefsoutfile . Wri te+Append , Def aul tAccess] , Wri te+Append] ; 
rOutStream <- CreateByteStream[NewFil e[routf i 1e , Wri te+Append , Def aultAccess] , Wri te+Append] ; 
Col lee t Array s[] ; OutStrings [compact] ; OutRecordDecl [compact] ; 
Wr i teDecimal [nArrays] ; Wri teString[" arrays, "]; 
Wri teDecimal[nStrings]; Wri teString[" strings, "]; 
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WriteDec imal[nChars]; WritGLine[" characters."]; 

InStream. des troy[InStream]; 

ENDLOOP; 

END 
END. . . 



